home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 08 - 1992 / 08.03 Jul 92 / Matrix Parser / MatrixOperations < prev    next >
Encoding:
Text File  |  1992-12-24  |  6.2 KB  |  309 lines  |  [TEXT/PJMM]
  1. unit MatrixOperations;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Globals;
  7.  
  8.  
  9.  
  10.     procedure matrixoperations (var amat, bmat, cmat: hdlsinglearraymatrix; var m1, n1, m2, n2, m3, n3: longint; var matrixoper: string30; var error: str255; var realresult: extended);
  11.  
  12.  
  13. implementation
  14.  
  15.  
  16.     procedure matrixoperations;
  17.  
  18.         label
  19.             999;
  20.  
  21.         var
  22.             i, j, k, l, ktype, numberofcols, aa, bb, mvalue: longint;
  23.             a, b, c, sum, x: extended;
  24.             bstring: str255;
  25.             realbinoperator: stringsize;
  26.  
  27.  
  28.  
  29.  
  30.         procedure realbinaryoperations1 (var realbinoperator: stringsize; var b1, b2, b3: extended; var error: str255);
  31.  
  32.             label
  33.                 999;
  34.  
  35.         begin
  36.  
  37.             if realbinoperator = plus then
  38.                 b3 := b1 + b2;
  39.             if realbinoperator = minus then
  40.                 b3 := b1 - b2;
  41.             if realbinoperator = asterisk then
  42.                 b3 := b1 * b2;
  43.             if realbinoperator = crosshatch then
  44.                 b3 := b1 * b2;
  45.             if realbinoperator = equals then
  46.                 b3 := b2;
  47.             if (realbinoperator = leftslash) and (b1 <> 0) then
  48.                 b3 := b2 / b1;
  49.             if (realbinoperator = leftslash) and (b1 = 0) then
  50.                 writeln('divide by zero');
  51.             if (realbinoperator = rightslash) and (b2 <> 0) then
  52.                 b3 := b1 / b2;
  53.             if (realbinoperator = rightslash) and (b2 = 0) then
  54.                 writeln('divide by zero');
  55.             if realbinoperator = exponent then
  56.                 begin
  57.                     if b1 = 0 then
  58.                         b3 := 0;
  59.                     if (b1 < 0) then
  60.                         b3 := -exp(b2 * ln(-b1));
  61.                     if b1 > 0 then
  62.                         b3 := exp(b2 * ln(b1));
  63.                     if b2 = 0 then
  64.                         b3 := 1;
  65.                 end;
  66.  
  67.  
  68. 999:
  69.         end;
  70.  
  71.  
  72.     begin
  73.  
  74.  
  75.         if (matrixoper = asterisk) then
  76.             begin
  77.                 m3 := m1;
  78.                 n3 := n2;
  79.  
  80.                 for i := 1 to m1 * n1 do
  81.                     amat^^[i] := amat^^[i + 2];
  82.  
  83.                 for i := 1 to m2 * n2 do
  84.                     bmat^^[i] := bmat^^[i + 2];
  85.  
  86.                 cmat^^[1] := m3;
  87.                 cmat^^[2] := n3;
  88.  
  89.                 l := 0;
  90.                 for i := 1 to m1 do
  91.                     for j := 1 to n2 do
  92.                         begin
  93.                             l := l + 1;
  94.                             sum := 0;
  95.                             for k := 1 to n1 do
  96.                                 sum := sum + amat^^[(i - 1) * n1 + k] * bmat^^[(k - 1) * n2 + j];
  97.                             cmat^^[l + 2] := sum;
  98.                         end;
  99.                 realresult := cmat^^[3];
  100.  
  101.                 goto 999;
  102.             end;
  103.  
  104.         if (matrixoper <> asterisk) then
  105.             begin
  106.  
  107.                 realbinoperator := matrixoper;
  108.                 if (m1 = 1) and (n1 = 1) then
  109.                     begin
  110.                         m3 := m2;
  111.                         n3 := n2;
  112.                         cmat^^[1] := m2;
  113.                         cmat^^[2] := n2;
  114.                         i := 3;
  115.                         repeat
  116.                             a := amat^^[3];
  117.                             b := bmat^^[i];
  118.                             realbinaryoperations1(realbinoperator, a, b, c, error);
  119.                             cmat^^[i] := c;
  120.                             i := i + 1;
  121.                         until i > m2 * n2 + 2;
  122.                         goto 999;
  123.                     end;
  124.  
  125.                 if (m2 = 1) and (n2 = 1) then
  126.                     begin
  127.                         m3 := m1;
  128.                         n3 := n1;
  129.                         cmat^^[1] := m1;
  130.                         cmat^^[2] := n1;
  131.                         i := 3;
  132.                         repeat
  133.                             a := amat^^[i];
  134.                             b := bmat^^[3];
  135.                             realbinaryoperations1(realbinoperator, a, b, c, error);
  136.                             cmat^^[i] := c;
  137.                             i := i + 1;
  138.                         until i > m1 * n1 + 2;
  139.                         goto 999;
  140.                     end;
  141.  
  142.                 if (m1 > 1) and (n1 > 1) and (m2 > 1) and (n2 > 1) then
  143.                     begin
  144.                         m3 := m2;
  145.                         n3 := n2;
  146.                         cmat^^[1] := m2;
  147.                         cmat^^[2] := n2;
  148.  
  149.                         i := 3;
  150.                         repeat
  151.                             a := amat^^[i];
  152.                             b := bmat^^[i];
  153.                             realbinoperator := matrixoper;
  154.                             realbinaryoperations1(realbinoperator, a, b, c, error);
  155.                             cmat^^[i] := c;
  156.                             if (i = 1) then
  157.                                 realresult := c;
  158.                             i := i + 1;
  159.                         until i > m1 * n1 + 2;
  160.  
  161.                     end;
  162.  
  163.  
  164.                 if (m1 = 1) and (n1 > 1) and (m2 > 1) and (n2 > 1) then
  165.                     begin
  166.                         m3 := m2;
  167.                         n3 := n2;
  168.  
  169.                         cmat^^[1] := m3;
  170.                         cmat^^[2] := n3;
  171.  
  172.                         l := 0;
  173.                         for i := 1 to m3 do
  174.                             for j := 1 to n3 do
  175.                                 begin
  176.                                     l := l + 1;
  177.                                     a := amat^^[j + 2];
  178.                                     b := bmat^^[n3 * (i - 1) + j + 2];
  179.                                     realbinoperator := matrixoper;
  180.                                     realbinaryoperations1(realbinoperator, a, b, c, error);
  181.                                     cmat^^[l + 2] := c;
  182.                                     if (l + 2 = 3) then
  183.                                         realresult := c;
  184.                                 end;
  185.                     end;
  186.  
  187.  
  188.                 if (m1 = 1) and (m2 = 1) and (n1 > 1) and (n2 > 1) then
  189.                     begin
  190.                         m3 := 1;
  191.                         n3 := n2;
  192.  
  193.                         cmat^^[1] := m3;
  194.                         cmat^^[2] := n3;
  195.  
  196.                         for i := 3 to m3 * n3 + 2 do
  197.                             begin
  198.                                 a := amat^^[i];
  199.                                 b := bmat^^[i];
  200.                                 realbinoperator := matrixoper;
  201.                                 realbinaryoperations1(realbinoperator, a, b, c, error);
  202.                                 cmat^^[i] := c;
  203.                                 if i = 3 then
  204.                                     realresult := c;
  205.                             end;
  206.  
  207.                     end;
  208.  
  209.  
  210.                 if (m2 = 1) and (m1 > 1) and (n1 > 1) and (n2 > 1) then
  211.                     begin
  212.                         m3 := m1;
  213.                         n3 := n2;
  214.  
  215.                         cmat^^[1] := m3;
  216.                         cmat^^[2] := n3;
  217.  
  218.                         l := 0;
  219.                         for i := 1 to m3 do
  220.                             for j := 1 to n3 do
  221.                                 begin
  222.                                     l := l + 1;
  223.                                     a := amat^^[n3 * (i - 1) + j + 2];
  224.                                     b := bmat^^[j + 2];
  225.                                     realbinoperator := matrixoper;
  226.                                     realbinaryoperations1(realbinoperator, a, b, c, error);
  227.                                     cmat^^[l + 2] := c;
  228.                                     if (l + 2 = 3) then
  229.                                         realresult := c;
  230.                                 end;
  231.  
  232.                     end;
  233.  
  234.                 if (n1 = 1) and (m1 > 1) and (m2 > 1) and (n2 > 1) then
  235.                     begin
  236.                         m3 := m2;
  237.                         n3 := n2;
  238.  
  239.                         cmat^^[1] := m3;
  240.                         cmat^^[2] := n3;
  241.  
  242.                         l := 0;
  243.                         for i := 1 to m3 do
  244.                             for j := 1 to n3 do
  245.                                 begin
  246.                                     l := l + 1;
  247.                                     a := amat^^[(i - 1) + 3];
  248.                                     b := bmat^^[n3 * (i - 1) + j + 2];
  249.                                     realbinoperator := matrixoper;
  250.                                     realbinaryoperations1(realbinoperator, a, b, c, error);
  251.                                     cmat^^[l + 2] := c;
  252.                                     if (l = 1) then
  253.                                         realresult := c;
  254.                                 end;
  255.  
  256.                     end;
  257.  
  258.  
  259.                 if (n1 = 1) and (n2 = 1) and (m1 > 1) and (m2 > 1) then
  260.                     begin
  261.                         m3 := m2;
  262.                         n3 := 1;
  263.  
  264.                         cmat^^[1] := m3;
  265.                         cmat^^[2] := n3;
  266.  
  267.                         for i := 3 to m3 * n3 + 2 do
  268.                             begin
  269.                                 a := amat^^[i];
  270.                                 b := bmat^^[i];
  271.                                 realbinoperator := matrixoper;
  272.                                 realbinaryoperations1(realbinoperator, a, b, c, error);
  273.                                 cmat^^[i] := c;
  274.                                 if i = 3 then
  275.                                     realresult := c;
  276.                             end;
  277.  
  278.                     end;
  279.  
  280.                 if (n2 = 1) and (m2 > 1) and (n1 > 1) and (m1 > 1) then
  281.                     begin
  282.                         m3 := m2;
  283.                         n3 := n1;
  284.  
  285.                         cmat^^[1] := m3;
  286.                         cmat^^[2] := n3;
  287.  
  288.                         l := 0;
  289.                         for i := 1 to m3 do
  290.                             for j := 1 to n3 do
  291.                                 begin
  292.                                     l := l + 1;
  293.                                     a := amat^^[n3 * (i - 1) + j + 2];
  294.                                     b := bmat^^[(i - 1) + 3];
  295.                                     realbinoperator := matrixoper;
  296.                                     realbinaryoperations1(realbinoperator, a, b, c, error);
  297.                                     cmat^^[l + 2] := c;
  298.                                     if (l = 1) then
  299.                                         realresult := c;
  300.                                 end;
  301.                     end;
  302.  
  303.             end;
  304.  
  305.  
  306. 999:
  307.     end;
  308.  
  309. end.